(in-package :parameterscout)

(defparameter *metrix-prefix-table*
  '((iso . 1d0)
    (#\k . 1d3)
    (#\M . 1d6)
    (#\G . 1d9)
    (#\T . 1d12)
    (#\P . 1d15)
    (#\E . 1d18)
    (#\Z . 1d21)
    (#\Y . 1d24)
    (#\m . 1d-3)
    (#\u . 1d-6)
    (#\n . 1d-9)
    (#\p . 1d-12)
    (#\f . 1d-15)
    (#\a . 1d-18)
    (#\z . 1d-21)
    (#\y . 1d-24))
  "An alist mapping metric prefix characters to their
  multipliers. Only the nice well-behaved ones are in here; the
  nasty weird prefixes like deka have been omitted on human
  rights grounds.")

;; Decoding expressions with metric prefixes. Not the cleanest code,
;; since it was partially written before I made the decision to bring
;; cl-ppcre into the program. It works, though!
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun float-char-p (char)
  "Is CHAR a character that can occur in a floating-point number?"
  (or (digit-char-p char)
      (member char '(#\. #\e #\E #\d #\D #\+ #\-))))

(defun decode-metrix-prefixed-expression (string)
  "Given a string in the format 'number[prefix]', return a
  double-float corresponding to the input. If no such number is
  found, return nil."
  (labels ((find-prefix (str)
	     (when (digit-char-p (elt str 0))
	       (find-if-not #'float-char-p str)))
	   (grab-number (str)
	     (let ((*read-eval* nil))
	       (read-from-string (subseq str 0 (position-if-not #'float-char-p str)) nil nil))))
    (let* ((number (grab-number string))
	   (prefix (or (find-prefix string) 'iso))
	   (multiplier (cdr (assoc prefix *metrix-prefix-table*))))
      (if multiplier
	  (* number multiplier)
	  (error "Metric prefix ~A is not known." prefix)))))

(defun string-remove-metric-prefixes (string)
  "Convert STRING into something that Infix can understand, by
  replacing metric prefixes with number literals."
  (cl-ppcre:regex-replace-all "\\s*([0-9.eEdD+-]+[kMGTPEZYmunpfazy])\\s*" 
			      string
			      #'(lambda (match group1 &rest junk)
				  (declare (ignore match junk))
				  (format nil " ~S " (decode-metrix-prefixed-expression group1)))
			      :simple-calls t))

;; Engineering notation
;;;;;;;;;;;;;;;;;;;;;;;

(defun print-float-for-engineers (num)
  "Given a double-float NUM, print it out in a format that
  engineers should find aestheically pleasing."
  (multiple-value-bind (normalized-num prefix)
      (convert-to-engineering-notation num)
    (format nil "~A~A"
	    (remove-trailing-zeros-and-maybe-the-decimal-point
	     (format nil "~,2F" normalized-num))
	    (if (characterp prefix) prefix ""))))

(defun floats-similar-magnitude-p (x y)
  "Are X and Y of a similar order of magnitude?"
  (< (/ (max x y) (min x y)) 2))

(defun convert-to-engineering-notation (num)
  "Given a double-float NUM, return a double-float and a metric
  prefix which are equivalent (save for floating-point error,
  which shouldn't be significant)."
  (let ((multiplier 1d0))
    (loop until (<= 1d0 num 1000d0)
       do (if (< num 1d0)
	      (progn (setf num (* num 1000d0))
		     (setf multiplier (/ multiplier 1000d0)))
	      (progn (setf num (/ num 1000d0))
		     (setf multiplier (* multiplier 1000d0)))))
    (let ((prefix (car (find multiplier *metrix-prefix-table* :key #'cdr :test #'floats-similar-magnitude-p))))
      (values num prefix))))

(defun remove-trailing-zeros-and-maybe-the-decimal-point (float-string)
  "Given a stringified version of a float in ~F syntax (not
  exponential syntax!), remove trailing zeros. If this leaves a
  decimal point at the end, remove it too."
  (prog ((end (length float-string)))
   :remove-more-trailing-zeros
   (when (char= (elt float-string (1- end)) #\0)
     (decf end)
     (go :remove-more-trailing-zeros))
   (when (char= (elt float-string (1- end)) #\.)
     (decf end))
   (return (subseq float-string 0 end))))